Sub duplicate_over_selection()
    '
    ' Recorded 29/02/2008
    '
    ' Description:
    '
    '
    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    
    
    If OrigSelection.Count = 1 Then
        MsgBox "There is only one shape selected in the shape range."
        Exit Sub
    End If

    ' first shape is the template
    Dim firstshape As Shape
    Set firstshape = OrigSelection.firstshape
    OrigSelection.Remove (1)
    
    Dim s As Shape
    Dim x As Double, y As Double
    Dim w As Double, h As Double
    For Each s In ActivePage.Shapes
        s.GetBoundingBox x, y, w, h
        firstshape.Duplicate
        firstshape.SetBoundingBox x, y, w, h
    Next s
End Sub

